home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / comm.swg / 0045_Check ALL COM ports.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-15  |  1.9 KB  |  92 lines
  1.  
  2. PROGRAM ComChk;
  3.  
  4. USES Crt;
  5.  
  6.   FUNCTION HexWord(a : Word) : String;
  7.   CONST
  8.     Digit          : ARRAY[$0..$F] OF Char = '0123456789ABCDEF';
  9.   VAR
  10.     I              : Byte;
  11.     HexStr         : String;
  12.  
  13.   BEGIN
  14.     HexStr := '';
  15.     FOR I := 1 TO 4 DO
  16.     BEGIN
  17.       Insert(Digit[a AND $000F], HexStr, 1);
  18.       a := a SHR 4
  19.     END;
  20.     HexWord := HexStr;
  21.   END;                            {hex}
  22.  
  23.  
  24. PROCEDURE UncodePort(NR : integer);
  25.   VAR
  26.     B, M, V1, V2, TLRC, D, MSB, LSB : integer;
  27.     S, CO : integer;
  28.     Baud : real;
  29.     Answer : string[10];
  30.     ComList : array[1..4] OF word ABSOLUTE $0000:$0400;
  31.   BEGIN
  32.     CO := ComList[NR];
  33.     WriteLn;
  34.     WriteLn ('Communications Port ', NR, ':');
  35.     IF CO = 0 THEN
  36.       BEGIN
  37.         WriteLn ('  Not installed.');
  38.         Exit;
  39.       END;
  40.  
  41.     S := Port[CO + 3];
  42.     TLRC := Port[CO + 3];
  43.     Port[CO + 3] := TLRC OR $80;
  44.     LSB := Port[CO];
  45.     MSB := Port[CO + 1];
  46.     D := 256 * MSB + LSB;
  47.     Baud := 115200.0 / D;
  48.     Port[CO + 3] := TLRC AND $7F;
  49.  
  50.     {Display port address}
  51.     WriteLn ('  Port address: ', HexWord (ComList[NR]));
  52.  
  53.     {Display baud rate}
  54.     WriteLn ('     Baud rate: ', Baud:5:0);
  55.  
  56.     {Display data bits}
  57.     IF (S AND 3) = 3 THEN
  58.       B := 8
  59.     ELSE IF (S AND 2) = 2 THEN
  60.       B := 7
  61.     ELSE IF (S AND 1) = 1 THEN
  62.       B := 6
  63.     ELSE
  64.       B := 5;
  65.     WriteLn ('     Data bits: ', B:5);
  66.  
  67.     {Display stop bits}
  68.     IF (S AND 4) = 4 THEN
  69.       B := 2
  70.     ELSE
  71.       B := 1;
  72.     WriteLn ('     Stop bits: ', B:5);
  73.  
  74.     IF (S AND 24) = 24 THEN
  75.       Answer := 'Even'
  76.     ELSE IF (S AND 8) = 8 THEN
  77.       Answer := 'Odd'
  78.     ELSE
  79.       Answer := 'None';
  80.     WriteLn ('        Parity: ', Answer:5);
  81.   END; {procedure Uncode_Setup_Of_Port}
  82.  
  83. BEGIN
  84.   ClrScr;
  85.   WriteLn ('Communications Port Status--------------------------');
  86.   UncodePort (1);
  87.   UncodePort (2);
  88.   UncodePort (3);
  89.   UncodePort (4);
  90. END.
  91.  
  92.